home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d4 / gw_slt13.arc / SOURCE.ARC / SLTMEM.PAS < prev   
Pascal/Delphi Source File  |  1990-04-01  |  8KB  |  293 lines
  1. PROGRAM SLTerm;  { for use with Joel Bergen's Global War Door }
  2.  
  3. USES
  4.   DOS, CRT, Async3, Mouse4, ANSI;
  5. TYPE
  6.   ScreenType = ARRAY [1..4000] OF BYTE;
  7. CONST
  8.   Version= '1.3';
  9.   Rev    = 'B';
  10.   Esc    = #27;
  11.   Ack    = #6;
  12.   AltI   = #23;
  13.   AltM   = #50;
  14.   AltX   = #45;
  15.   GWEnq  = #255;
  16.   Alpha  = ['A'..'Z','0'..'9','a'..'z','.',':','_'];
  17.   Special= ['!','"','#','$','&','%','0'..'9'];
  18. VAR
  19.   ScreenColor       : ScreenType ABSOLUTE $B800:0000;  {color}
  20.   ScreenVGA         : ScreenType ABSOLUTE $B800:4000;  {50 line}
  21.   ScreenMono        : ScreenType ABSOLUTE $B000:0000;  {mono}
  22.   buf               : ScreenType;
  23.   Color,Local,Done  : BOOLEAN;
  24.   c,ch              : CHAR;
  25.   ComPort,
  26.   x,y,w,result      : WORD;
  27.   Regs              : REGISTERS;                       {DOS registers}
  28.   f                 : FILE;                            {for Maps}
  29.   f2                : TEXT;                            {for Capture}
  30.   f3                : FILE;                            {disk buffer}
  31.   i                 : INTEGER;
  32.   s                 : STRING;
  33.   Cap               : STRING[80];
  34.   Store,Lines       : BYTE;
  35.  
  36. PROCEDURE ExitProgram;
  37. BEGIN
  38.   Async_Close;
  39.   CLOSE(f);
  40.   IF Mouse_Installed THEN BEGIN
  41.     RestoreMouseXY;
  42.     HideMouse;
  43.   END;
  44.   WRITELN('Shadow Lord''s Enhanced Global War Term (Memory Saving Version) exited.');
  45.   HALT;
  46. END;
  47.  
  48.  
  49. FUNCTION ScreenChar(x,y:word) : CHAR;
  50. BEGIN
  51.   IF Color THEN
  52.     ScreenChar:=CHR(ScreenColor[((y-1)*80+x)*2-1])
  53.   ELSE
  54.     ScreenChar:=CHR(ScreenMono[((y-1)*80+x)*2-1]);
  55. END;
  56.  
  57. PROCEDURE Capture;
  58. BEGIN
  59.   ASSIGN(f2, 'SLTERM.IMG');
  60.   {$I-} APPEND(f2); {$I+}
  61.   IF IOResult<>0 THEN REWRITE(f2);
  62.   FOR Y:=1 TO 25 DO BEGIN
  63.     Cap:='';
  64.     FOR X:=1 TO 80 DO
  65.      Cap:=Cap+ScreenChar(X,Y);
  66.     WRITE(f2,Cap);
  67.   END;
  68.   CLOSE(f2);
  69. END;
  70.  
  71. FUNCTION MouseWord(x,y,len : WORD) : STRING;
  72. {mouse routine: gets a word pointed to by the mouse. For reading country
  73.  names, menu items, etc}
  74. VAR
  75.   s : STRING;
  76.   i : WORD;
  77. BEGIN
  78.   s:='';
  79.   IF ScreenChar(x,y) IN Alpha THEN BEGIN
  80.     WHILE (x>0) AND (ScreenChar(x,y) IN Alpha) DO
  81.       DEC(x);
  82.     IF (x>0) AND (ScreenChar(x,y)=' ') AND (ScreenChar(x-1,y) IN Alpha)
  83.     THEN BEGIN
  84.       DEC(x);
  85.       WHILE (x>0) AND (ScreenChar(x,y) IN Alpha) DO
  86.         DEC(x);
  87.     END;
  88.     INC(x);
  89.     FOR i:=1 TO len DO BEGIN
  90.       s:=s+ScreenChar(x,y);
  91.       INC(x);
  92.     END;
  93.   END;
  94.   MouseWord:=s;
  95. END;
  96.  
  97. PROCEDURE Menu;
  98. VAR
  99.   Choice: BYTE;
  100.   Chce  : STRING;
  101.   i,w   : Byte;
  102. BEGIN
  103.   IF Mouse_Installed THEN HideMouse;
  104.   i:=WhereY;
  105.   w:=WhereX;
  106.   IF Color THEN Move(ScreenColor, buf, 4000)
  107.    ELSE Move(ScreenMono, buf, 4000);
  108.   IF Mouse_Installed THEN ShowMouse;
  109.   Choice:=10;
  110.   GotoXY(1,23);
  111.   TextColor(7);
  112.   Writeln('  1:Globe  2:Africa  3:Asia  4:Australia  5:Europe  6:N.America  7:S.America ');
  113.   Writeln(' 8:Show_Player_Info  9:World_Report  0:Exit_Menu   Shadow Lord''s Enhanced GWT ');
  114.   WHILE Choice>9 DO BEGIN
  115.     IF Mouse_Installed THEN BEGIN
  116.       repeat until mouseposition(x,y)=0;
  117.       if MousePosition(x,y)>0 THEN BEGIN
  118.        Chce:=MouseWord(x,y,6);
  119.        IF LENGTH(Chce)>1 THEN
  120.         IF Chce[2]=':' THEN
  121.          if (Chce<='9') OR (Chce>='9') THEN VAL(Chce[1], Choice, result);
  122.        repeat until Mouseposition(x,y)=0;
  123.       END;
  124.     END;
  125.     IF KeyPressed THEN BEGIN;
  126.       Chce:=ReadKey;
  127.       if (Chce<='9') OR (Chce>='0') THEN VAL(Chce, Choice, result);
  128.     END;
  129.   END;
  130.   IF Mouse_Installed THEN HideMouse;
  131.   IF Choice>0 THEN SEEK(f3, (choice-1)*4000);
  132.   IF Color THEN Move(buf, ScreenColor, 4000)
  133.    ELSE Move(buf, ScreenMono, 4000);
  134.   IF (Choice>0) AND (Lines=50) THEN
  135.     BlockRead(f3, ScreenVGA, 4000)
  136.   ELSE IF (Choice>0) AND (Lines=25) THEN
  137.     BlockRead(f3, ScreenColor, 4000);
  138.   IF (Lines=25) and (ScreenChar(31,11)='N') then begin
  139.     repeat until keypressed;
  140.     if color then move(buf, ScreenColor, 4000)
  141.      else move(buf, ScreenMono, 4000);
  142.   end;
  143.   IF Mouse_Installed THEN ShowMouse;
  144.   GotoXY(w,i);
  145. END;
  146.  
  147. FUNCTION WaitForChar : CHAR;
  148. VAR t : WORD;
  149. BEGIN
  150.   t:=0;
  151.   REPEAT
  152.     INC(t);
  153.   UNTIL (t>65500) OR Async_Buffer_Check;
  154.   IF Async_Buffer_Check THEN
  155.     WaitForChar:=Async_Read
  156.   ELSE
  157.     WaitForChar:=#00;
  158. END;
  159.  
  160. BEGIN
  161.   ASSIGN(f,FEXPAND(FSEARCH('WAR.IMG',GETENV('PATH'))));
  162.   w:=IORESULT;
  163.   {$I-} RESET(f,1); {$I+}
  164.   IF IORESULT<>0 THEN BEGIN
  165.     WRITELN('WAR.IMG not found!');
  166.     HALT;
  167.   END;
  168.   IF FileSize(f)<32000 THEN BEGIN
  169.     WRITELN('You must use one of SLTerm''s Enhanced WAR.IMGs!'^G^G);
  170.     ExitProgram;
  171.   END;
  172.   ASSIGN(f3, 'SLWARBUF.IMG');
  173.   {$I-} REWRITE(f3,1); {$I+}
  174.   IF (IORESULT<>0) THEN BEGIN
  175.     WRITELN('Disk Error Creating SLWARBUF.IMG'^G^G);
  176.     ExitProgram;
  177.   END;
  178.   SEEK(f, 7*4000);
  179.   BLOCKREAD(f,buf,4000);
  180.   FOR X:=1 to 9 DO BEGIN
  181.     SEEK(f3,(x-1)*4000);
  182.     BLOCKWRITE(f3,buf,4000);
  183.   END;
  184.   VAL(PARAMSTR(1),ComPort,result);
  185.   VAL(PARAMSTR(2),Lines,result);
  186.   IF (ComPort<1) OR (ComPort>4) THEN
  187.    BEGIN
  188.     WRITELN('USAGE:  SLTERM ComPort(1-4) #Lines(25 or 50)');
  189.     CLOSE(f);
  190.     HALT;
  191.    END;
  192.   Regs.AH := $0F;
  193.   INTR($10,Regs);
  194.   IF Regs.AL=7 THEN
  195.     Color:=FALSE
  196.   ELSE
  197.     Color:=TRUE;
  198.   IF (Lines<>25) AND (Lines<>50) THEN Lines:=25; {Default to 25 Lines}
  199.   Async_CheckCTS := FALSE; {disable hardware handshaking}
  200.   Done:=NOT Async_Open(ComPort);
  201.   IF Lines=50 THEN TextMode(3+256);              {50 line mode}
  202.   IF NOT Done THEN WRITELN('SLTMEM Version ',Version,' active.');
  203.   IF NOT Done THEN WRITELN('Alt-X to Exit, Alt-M for Menu, Alt-I to capture screen.');
  204.   IF Mouse_Installed THEN ShowMouse;
  205.   Store:=10;
  206.   WHILE NOT Done DO BEGIN
  207.     REPEAT
  208.       c:=#00;
  209.       IF Async_Buffer_Check THEN BEGIN
  210.         c:=Async_Read;
  211.         Local:=FALSE;
  212.       END ELSE IF KEYPRESSED THEN BEGIN
  213.         ch:=READKEY;
  214.         Local:=TRUE;
  215.         IF ch<>#0 THEN
  216.           Async_Send(ch)
  217.         ELSE BEGIN
  218.           ch:=ReadKey;
  219.           IF ch=AltX THEN ExitProgram; {alt-x quits program}
  220.           IF ch=AltM THEN Menu;        {alt-m calls up menu}
  221.           IF ch=AltI THEN Capture;     {alt-i captures screen}
  222.         END;
  223.       END
  224.       ELSE IF Mouse_Installed AND (MousePosition(x,y)>0) AND
  225.        (MousePosition(x,y)<3) THEN BEGIN
  226.         IF MousePosition(x,y)=2 THEN
  227.           Async_Send(#13)
  228.         ELSE BEGIN
  229.           IF ScreenChar(x,y) IN Special THEN S:=Screenchar(x,y)+':'
  230.           ELSE If ScreenChar(x,y) IN Alpha THEN S:=MouseWord(x,y,5);
  231.           c:=s[1];
  232.           IF s<>''THEN BEGIN
  233.             IF S[2]=':' THEN
  234.               Async_Send(c)
  235.             ELSE BEGIN
  236.               FOR i:=1 TO 5 DO
  237.                 Async_Send(s[i]);
  238.               Async_Send(#13);
  239.             END;
  240.           END;
  241.         END;
  242.         REPEAT UNTIL MousePosition(x,y)=0;
  243.         c:=#00;
  244.       END
  245.       ELSE IF Mouse_Installed AND (MousePosition(x,y)=4) THEN Menu;
  246.       IF NOT Async_Buffer_Check AND (Store<10) THEN BEGIN
  247.          Seek(f3, (Store-1)*4000);
  248.          IF Color THEN BlockWrite(f3, ScreenColor, 4000)
  249.          ELSE BlockWrite(f3, ScreenMono, 4000)
  250.       END;
  251.    UNTIL c<>#00;
  252.    IF Mouse_Installed THEN HideMouse;
  253.    IF (c=ESC) AND (NOT Local) THEN
  254.      BEGIN
  255.         c:=WaitForChar;
  256.         CASE c OF
  257.         GWEnq:BEGIN
  258.                 Async_Send(ACK);
  259.                 Async_Send(REV);
  260.                 c:=WaitForChar;
  261.                 IF c<>ACK THEN BEGIN
  262.                   WRITELN('THIS IS AN OBSELETE VERSION OF SLTERM!'^G^G);
  263.                   DELAY(5000);
  264.                 END;
  265.               END;
  266.           'M':BEGIN
  267.                 c:=WaitForChar;
  268.                 i:=ORD(c) - ORD('1');
  269.                 IF (i>=0) AND (i < (FILESIZE(f) DIV 4000)) THEN BEGIN
  270.                   SEEK(f,i*4000);
  271.                   Store:=i+1;
  272.                   BLOCKREAD(f,buf,4000);
  273.                   IF Color THEN
  274.                     MOVE(buf,ScreenColor,4000)
  275.                   ELSE
  276.                     MOVE(buf,ScreenMono,4000);
  277.                 END;
  278.               END;
  279.           'Q':Done := TRUE;
  280.           ELSE BEGIN
  281.             Display_ANSI(ESC);
  282.             Display_ANSI(c);
  283.           END;
  284.         IF ScreenChar(1,3)='~' THEN Store:=8         {player info}
  285.         ELSE IF ScreenChar(3,2)='A' THEN Store:=9;   {world report}
  286.       END;
  287.     END
  288.     ELSE Display_ANSI(c);
  289.     IF Mouse_Installed THEN ShowMouse;
  290.   END;
  291.   ExitProgram;
  292. END.
  293.